open Fr
open FrGui_common
open FrGui_actions

class window ?(visible=true_b) widget = object
	method widget = (widget :> GWindow.window)
	
	val mutable handle = None
	val mutable count = 0
	method show () =
		match handle with
		| None ->
			handle <- Some (register_b (lift begin
				if @visible then widget#show ()
				else widget#misc#hide ()
			end));
			assert (count = 0)
		| Some _ ->
			count <- count + 1
	method hide () =
		if count = 0 then
			match handle with
			| Some h ->
				handle <- None;
				unregister h;
				widget#misc#hide ()
			| None -> assert false
		else count <- count - 1
end

let make_statusbar w =
	let sb = GMisc.statusbar () in
	(* sb should really be a subclass of box, not container_full
	 * (it's derived from GtkHBox) but we don't currently need
	 * to do this *)
	(*let hb = new GPack.box
		(GtkBase.Object.try_cast sb#as_widget "GtkBox") in*)
	List.iter (fun w -> w#misc#hide ()) sb#children;
	let frame = GBin.frame
		~shadow_type: `IN
		~packing: sb#add () in
	frame#add w;
	sb#coerce

let window ?visible ?label ?menu_bar ?status_bar child =
	let widget = GWindow.window ?title: label () in
	let vbox = GPack.vbox ~packing: widget#add () in
	option_may (fun w -> vbox#pack (gtk_menu_bar w)#coerce) menu_bar;
	vbox#pack ~expand: true child#widget;
	option_may (fun w -> vbox#pack (make_statusbar w#widget)) status_bar;
	let delete_receiver, delete_event = event_receiver () in
	ignore (widget#event#connect#delete (fun _ ->
		send_event delete_receiver (); true));
	new window ?visible widget, delete_event

(* should we have feedback function? *)
let swindow ?(visible=true_b) ?label ?menu_bar ?status_bar child_fun i =
	let frame = GBin.frame
		~shadow_type: `NONE
		~border_width: 0 () in
	let window, delete_event =
		window ~visible ?label ?menu_bar ?status_bar
			(new simple_widget frame) in
	let b = scollapse_b id i (lift (fun v ->
		if @visible then
			(let child, b = child_fun v in
			frame#add child#widget; b)
		else
			((try frame#remove frame#child with _ -> ());
			lift v))) in
	window, (delete_event, b)

let list_diffq a b =
	List.filter (fun i -> not (List.memq i b)) a,
	List.filter (fun i -> not (List.memq i a)) b

let idelta f i b =
	merge_e [delta f b; map_e (f i) (snapshot_b b now)]

let show windows =
	ignore (register_e (on (idelta list_diffq [] windows) (remove, add) ->
		(* note: because windows are shown at most once we could
		 * swap the order of these two statements and forget the delta stuff
		 * but for now we'll do this *)
		List.iter (fun w -> w#hide ()) remove;
		List.iter (fun w -> w#show ()) add))

let run exit =
	let ret = ref None in
	let exit_handle =
		register_e (lift (
			ret := Some %exit;
			GMain.Main.quit ())) in
	GMain.Main.main ();
	unregister exit_handle;
	assert (!ret <> None);
	option_get !ret

let run_window (window, exit) =
	window#show ();
	let r = run exit in
	window#hide (); r
